home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / MAC_PRGS.M2 / VBLTEST.M < prev   
Encoding:
Text File  |  1997-02-07  |  2.2 KB  |  83 lines
  1. MODULE VBLTest;
  2.  
  3. (*
  4.  * Dieses Programm demonstriert, wie Modula-Funktionen in Exception-
  5.  * Vektoren installiert werden können.
  6.  *
  7.  * Hier wird die Prozedur 'vbl' im Interrupt-Vektor (Level 4) installiert.
  8.  * Somit wird sie ca. 50-70 Mal pro Minute aufgerufen. Die Funktion läßt
  9.  * zur Kontrolle ein kleines Lauflicht oben links auf dem Bildschirm er-
  10.  * scheinen.
  11.  *
  12.  * Wird das Modul unter der Shell gestartet, kann es beim Beenden der Shell
  13.  * oder durch wiederholten Start wieder freigegeben werden.
  14.  *
  15.  * Achtung:
  16.  *   Das Modul darf nicht vollständig optimiert werden, wenn es gelinkt
  17.  *   werden soll. Vielmehr ist die mittlere Optimierung zu wählen, damit
  18.  *   die Link-Informationen zum Residentmachen des Programms erhalten
  19.  *   bleiben.
  20.  *)
  21.  
  22. FROM SYSTEM IMPORT ADDRESS, ADR, TSIZE, BYTE, WORD, LONGWORD;
  23. FROM MOSGlobals IMPORT MemArea;
  24. FROM SysTypes IMPORT ExcSet, ExcDesc, IRLevel4;
  25. FROM Excepts IMPORT DeInstallExc, SysInstallPreExc;
  26. FROM InOut IMPORT WriteString, WriteLn, WriteCard, Write, BusyRead;
  27.  
  28. CONST freq = 100;
  29.  
  30. VAR cnt2[4]: LONGCARD;
  31.  
  32. VAR bp, oldv, hdl: ADDRESS;
  33.     ch: CHAR;
  34.     tick, ok: BOOLEAN;
  35.     st: ARRAY [1..1000] OF CARDINAL;
  36.     ticks, vbl_cnt, c2, i,a:CARDINAL;
  37.     p: POINTER TO ARRAY [0..399] OF ARRAY [0..39] OF BITSET;
  38.     vblwsp, termwsp: MemArea;
  39.     l: LONGCARD;
  40.  
  41.  
  42. PROCEDURE vbl (VAR x: ExcDesc): BOOLEAN;
  43.   (*$R- keine Püfungen, damit es etwas schneller geht *)
  44.   VAR b: BITSET;
  45.   BEGIN
  46.     INC (vbl_cnt);
  47.     IF (vbl_cnt MOD freq) = 0 THEN
  48.       INC (ticks);
  49.       tick:= TRUE;
  50.     END;
  51.     RETURN TRUE
  52.   END vbl;
  53.   (*$R=*)
  54.  
  55. BEGIN
  56.   vblwsp.bottom:= ADR (st);
  57.   vblwsp.length:= SIZE (st);
  58.   SysInstallPreExc (ExcSet {IRLevel4}, vbl, FALSE, vblwsp, hdl);
  59.   IF hdl # NIL THEN
  60.     vbl_cnt:= 0;
  61.     ticks:= 0;
  62.     tick:= FALSE;
  63.     cnt2:= 0;
  64.     l:= cnt2 + freq;
  65.     LOOP
  66.       BusyRead (ch);
  67.       IF (ch # 0C) THEN EXIT END;
  68.       IF cnt2 >= l THEN
  69.         l:= cnt2 + freq;
  70.         WriteString ("        ");
  71.         WriteCard (cnt2 DIV freq, 0);
  72.         WriteLn;
  73.       END;
  74.       IF tick THEN
  75.         tick:= FALSE;
  76.         WriteCard (ticks, 0);
  77.         WriteLn;
  78.       END;
  79.     END;
  80.     DeInstallExc (hdl);
  81.   END
  82. END VBLTest.
  83.